#
#
# Auxillary FileTable modules
# These routines are only used by maintenance and debug programs
#
package FileTable;

use strict;
use IO::Handle;

use vars qw($reccount $tick);
# used to keep counts for displays
$reccount = 0; # what displays
$tick = undef; # callback for ticking
#
# Reclean the whole file. Takes time!
#
sub reclean {
    my $self = shift;
    $tick = shift;
    my $file = $self->{"*FILE"};
    my $rec;
    my $key;
    if (!$self->{"*CLEAN"}) {
	die "reclean: clean not set for this file\n";
    }
    $reccount = 0;
    while ($key = $self->each) {
	progressTick();
	$rec = $self->get($key);
	$rec->clean if $rec;
    }
}
    
#
# Rebuild the database. Takes even more time!
#
sub rebuilddb {
    my $self = shift;
    my $field;
    my $value;

    $tick = shift;
    my $LOCK_EX = 2;
    my $textfile = "$self->{'*NAME'}.txt";
    my $object;
    my $key;
    my $storeerrors;
    my $textform;

    open(TEXTFILE, $textfile); # For input
    flock(TEXTFILE, $LOCK_EX); # prevent updates while we work
    $reccount = 0;
    while (<TEXTFILE>) {
	#print STDERR;
	if (/^\/\//) {
	    my $nextkey = $'; #'
	    chop $nextkey;
	    # this crashes under Perl 5.0005 RH 6.0
	    #progressTick(TEXTFILE->input_line_number);
	    if ($textform) {
		#print STDERR "Storing rec $key\n";
		$object = $self->makeobject($key, $textform);
		eval '$object->patch()' if ($object);
		if ($@) {
		    warn "Error: $@\n";
		    ++ $storeerrors;
		}
		undef $textform;
	    }
	    $key = $nextkey;
	} else {
	    $textform .= $_;
	}
    }
    if ($textform) {
	#print STDERR "Storing rec $key\n";
	$object = $self->makeobject($key, $textform);
	eval '$object->patch()' if ($object);
	if ($@) {
	    warn "Error: $@\n";
	    ++ $storeerrors;
	}
	undef $textform;
    }
    warn "Number of store errors: $storeerrors\n";
}
#
# Rebuild a single record ID from the textfile.
#
sub rebuildrec {
    my $self = shift;
    my $key = shift;
    $tick = shift;
    my $LOCK_EX = 2;
    my $textfile = "$self->{'*NAME'}.txt";
    my $object;
    my $tracking = 0;
    my $vernum = 0;
    my $fieldcount;
    my $oldobject;
    my $oldvernum;
    my $field;
    my $value;
    open(TEXTFILE, $textfile); # For input
    $reccount = 0;
    while (<TEXTFILE>) {
	#print STDERR;
	chop;
	if (/^\/\//) {
	    #progressTick(input_line_number TEXTFILE);
	    progressTick();
	    if ($key eq $') {
		# Save last non-deleted object
		$oldobject = $object if $fieldcount > 0
		    && $object->{f_state} ne "DELETED";
		$oldvernum = $vernum;
		++ $vernum;
		print STDERR "Starting rec $key version $vernum\n";
		$object = $self->new();
		$fieldcount = 0;
		$object->{"*KEY"} = $key;
		$tracking = 1;
	    } else {
		$tracking = 0;
	    }
	} elsif ($tracking) {
	    if (/:/) {
		$field = $`;
		$value = $'; #'
		$object->{$field} = $value;
		print STDERR; print STDERR "\n";
		++ $fieldcount;
	    } else {
		print STDERR "$key: Illegal line at line $.\n";
	    }
	}
    }
    if ($object) {
	if ($fieldcount == 0 || $object->{f_state} eq "DELETED") {
	    print STDERR "Ignoring delete in $vernum\n";
	    print STDERR "Storing version $oldvernum of record $key\n";
	    $oldobject->patch();
	} else {
	    print STDERR "Storing version $vernum of record $key\n";
	    $object->patch();
	}
    } else {
	print STDERR "Object not found\n";
    }
}


# weirdly, this routine seems positively defiant not to be called....

sub progressTick {
    ++ $reccount;
    if ($tick) {
	&$tick($reccount, @_);
    } elsif ($reccount % 100 == 0 && -t STDERR) {
	print STDERR "$reccount\r";
    }
}

# SQL manipulation: Make a field into a new column of the table.
# Args: 1) fieldname, 2) datatype
sub addsqlfield {
    my $self = shift;
    my $field = shift;
    my $datatype = shift;

    my $dbhandle = $self->dbhandle();
    my $table = $$self{_TABLE};
    my ($sth, $status, $key, $rec, $modcount);

    $sth = $dbhandle->prepare("ALTER TABLE $table ADD $table.$field $datatype NOT NULL");
    $status = $sth->execute();
    if (!$status) {
	die "ALTER TABLE failed: ", $sth->errstr, "\n";
    }
    warn "Column $field added to $table\n";
    $self->gettableinfo(); # get info that includes new field name
    $sth = $dbhandle->prepare("UPDATE $table SET $table.$field=? WHERE f_key=?");
    while ($key = $self->each()) {
	$rec = $self->getclean($key);
	if (defined($rec->{$field})) {
	    ++ $modcount;
	    $status = $sth->execute($rec->{$field}, $key);
	    die "UPDATE error on setting $field to $$rec{$field} in $key\n"
		if !$status;
	}
	progressTick;
    }
    return $modcount;
}
# 
sub renamefield {
    my $self = shift;
    my $field = shift;
    my $newname = shift;
    my (@affected, $falseselectcount, $modcount);

    $falseselectcount = 0;
    $modcount = 0;
    warn "Renaming field $field to $newname\n";
    @affected = $self->select("f_raw like '%$field:%'");
    for my $rec (@affected) {
	if (defined($$rec{$field})) {
	    if (defined($$rec{$newname})) {
		warn "Rename: Collision in record ", $rec->key(), "\n";
	    } else {
		$$rec{$newname} = $$rec{$field};
		delete $$rec{$field};
		++ $modcount;
		$rec->patch();
	    }
	} else {
	    ++ $falseselectcount;
	}
    }
    warn "$falseselectcount records falsely selected\n";
    return $modcount;
}

# RECORD based debug routines

package FileTable::Record;

1;
